home *** CD-ROM | disk | FTP | other *** search
/ Spanish Scene 1 / SpanishScene1.iso / spanish pack n°1 by llfb / revistas / fanzine / fanzine01.dms / fanzine01.adf / 20 < prev    next >
Text File  |  1977-12-31  |  7KB  |  272 lines
  1.  
  2.   ---------------------------------------------------------------------------
  3.  
  4.                  S O U R C E S    Y   S O U R C E S I T O S
  5.          
  6.   ---------------------------------------------------------------------------
  7.  
  8.  
  9.    Nos gustaría en cada número, incluir algunas rutinas, bien en ensamblador o
  10.   en cualquier otro lenguaje, pues creemos que pueden ser interesantes. Así
  11.   que ya sabéis, si tenéis alguna, ¡enviarla ya!.
  12.  
  13.    En este primer número incluimos una rutina bastante interesante para ex-
  14.   traer raíces cuadradas, tanto en Assembler como en C.
  15.  
  16.  
  17.     ; Esta es una rutina super-rápida para extraer la raiz cuadrada de
  18.     ; un número
  19.     ; (En principio de 16 bits)
  20.     ;
  21.     ; © OTTO PETER, Innsbruck
  22.  
  23.  
  24.    ROOT:
  25.  
  26.    ;       SETTINGS IN:      D0.w   -   number
  27.    ;
  28.    ;               OUT:      D0.w   -   result
  29.    ;                                -   sign- and zeroflag are valid
  30.  
  31.    movem.w      d1-d3,-(sp)
  32.    move.w  #$4000,d2
  33.  
  34.    root_loop:
  35.    move.w       d1,d3
  36.    add.w        d2,d3
  37.  
  38.    lsr.w        #1,d1
  39.    cmp.w        d3,d0
  40.    ble.s        boing
  41.    sub.w        d3,d0
  42.    or.w         d2,d1
  43.  
  44.    boing:
  45.    lsr.w        #2,d2
  46.    bne.s        root_loop
  47.  
  48.    cmp.w        d1,d0
  49.    blt.s        no_round_up
  50.    addq.w       #1,d1
  51.  
  52.    no_round_up:
  53.    move.w       d1,d0
  54.    movem.w      (sp)+,d1-d3
  55.    rts
  56.  
  57.  
  58.    ;*************************************************
  59.    ;       Rutina para números en 32 bits
  60.    ;*************************************************
  61.    exp_offset:    equ $7f
  62.  
  63.  
  64.    domain_error:        ;Error if number is negative
  65.    movem.l      (a7)+,d1-d4
  66.    rts
  67.  
  68.    sq_0:
  69.    clr.l        d0
  70.    movem.l      (a7)+,d1-d4
  71.    rts
  72.  
  73.    sqrt:
  74.    movem.l      d1-d4,-(a7)     ;Save d1-d4
  75.    move.l       d0,d4
  76.    bmi.s        domain_error    ;Error if number is negative
  77.    swap    d4                      ;MSW of number
  78.    and.l        #$7f80,d0       ;isolate exponent
  79.    beq.s        sq_0            ;exponent is 0 => root is 0
  80.    and.l        #$007fffff,d0           ;isolate mantisse
  81.    sub.w        #exp_offset*$80,d4      ;exponent in `2^i`-format
  82.    bclr         #7,d4                           ;exponent even?
  83.    beq.s        even_exp
  84.    add.l        d0,d0                   ;mantisse * 2
  85.    add.l        #$01000000-$00800000,d0 ;set hidden-bit
  86.  
  87.    even_exp:
  88.    asr.w        #1,d4                   ;exponent / 2
  89.    add.w        #exp_offset*$80,d4      ;exponent in offset-format
  90.    swap         d4
  91.  
  92.    lsl.l        #7,d0
  93.  
  94.    move.l       #$40000000,d2           ;xroot after 1. interation
  95.    move.l       #$10000000,d3           ;m2 = 2 << (maxbit-1)
  96.  
  97.    loop1_0:
  98.    move.l       d0,d1                   ;xx2 = x
  99.  
  100.    loop1_1:
  101.    sub.l        d2,d1                   ;xx2 -= xroot
  102.    lsr.l        #1,d2                   ;xroot >>= 1
  103.    sub.l        d3,d1                   ;x2 -= m2
  104.    bmi.s        dont_set1
  105.    move.l       d1,d0                   ;x = xx2
  106.    or.l         d3,d2                   ;xroot += m2
  107.    lsr.l        #2,d3                   ;m2 >>= 2
  108.    bne.s        loop1_1
  109.    bra.s        d0_d1_same
  110.    
  111.    dont_set1:
  112.    lsr.l        d2,d3                   ;m2 >>= 2
  113.    bne.s        loop1_0                 ;repeat loop 15 times (bit 22..8)
  114.  
  115.    move.l       d0,d1
  116.  
  117.    d0_d1_same:
  118.    sub.l        d2,d1                   ;xx2 -= xroot
  119.    ror.l        #1,d2                   ;xroot >>= 1 (with carry)
  120.    swap         d2                      ;turn to new aligment
  121.    subq.l       #1,d1                   ;carry of 0-0x4000: x2 -= m2 (part 1)
  122.    bmi.s        dont_set7
  123.  
  124.    or.l         #-$40000000,d1                  ;0-0x4000: x2 -= m2 (part 2)
  125.    move.l       d1,d0
  126.    or.w         #$4000,d2
  127.  
  128.    dont_set7:
  129.    swap         d0                      ;turn x to new aligment
  130.  
  131.    move.w       #$1000,d3               ;m2 - bit 16..31 = 0
  132.  
  133.    loop2_0:
  134.    move.l       d0,d1                   ;xx2 = x
  135.  
  136.    loop2_1:
  137.    sub.l        d2,d1                   ;xx2 = xroot
  138.    lsr.l        #1,d2                   ;xroot >>= 1
  139.    sub.l        d3,d1
  140.    bmi.s        dont_set2
  141.  
  142.    move.l       d1,d0                   ;x = xx2
  143.    or.l         d3,d2                   ;xroot += m2
  144.    lsr.w        #2,d3                   ;m2 >>= 2
  145.    bne.s        loop2_1
  146.  
  147.    bra.s        finish
  148.  
  149.    dont_set2:
  150.    lsr.w        #2,d3                   ;m2 >>= 2
  151.    bne.s        loop2_0                 ;repeat loop 7 times (n=6..0)
  152.  
  153.    finish:
  154.    sub.l        d2,d0                   ;round root?
  155.    bls.s        no_inc
  156.    addq.l       #1,d2                   ;round up!
  157.  
  158.    no_inc:
  159.    bclr         #23,d2                  ;clear hidden bit
  160.    or.l         d4,d2                   ;combine exponent and mantisse
  161.    move.l       d2,d0                   ;result
  162.    movem.l      (a7)+,d1-d4
  163.    rts
  164.  
  165.  
  166.     ----------------     C     -------------------------------
  167.  
  168.  
  169.    #define N_BITS 32
  170.    #define MAX_BIT ((N_BITS + 1) / 2 - 1)
  171.  
  172.    unsigned long int sqrt_1(x)
  173.      unsigned long int x;
  174.      {
  175.      register int i;
  176.      register unsigned long int m, r, root;
  177.  
  178.      root = 0;  m = 1 << MAX_BIT
  179.      for (i = MAX_BIT;  i >= 0;  i--)
  180.        {
  181.        r = root + m;
  182.        if (r * r <= X) root = r;
  183.        m >>= 1;                           
  184.        }
  185.      return root;
  186.      }
  187.  
  188.  
  189.    unsigned long int sqrt_2(x)
  190.      unsigned long int x;
  191.      {
  192.      register long int i;
  193.      register unsigned long int m, r2, root;
  194.      unsigned long int root2;
  195.  
  196.      root2 = root = 0;  m = 1 << MAX_BIT;
  197.      for (i = MAX_BIT;  i >= 0;  i--)
  198.        {
  199.        r2 = root2 + (root << i + 1)  +  (1 << i + i);
  200.        if (r2 <= X)
  201.          {
  202.          root2 = r2;  root += m;
  203.          }
  204.        m >>= 1;
  205.        }
  206.      return root;
  207.      }
  208.  
  209.  
  210.    unsigned long int sqrt_3(x)
  211.      unsigned long int x;
  212.      {
  213.      register unsigned long int m2, r2, xroot, root2;
  214.      int i;
  215.  
  216.      root2 = xroot = 0;  m2 = 1 << MAX_BIT * 2;
  217.   for (i = MAX_BIT;  i >= 0;  i--)
  218.        {
  219.        r2 = root2 + xroot + m2;
  220.        xroot >>= 1;
  221.        if (r2 <= X)
  222.          {
  223.       root2 = r2;  xroot += m2;
  224.          }
  225.             m2 >>= 2;
  226.        }
  227.      return xroot;
  228.      }
  229.  
  230.  
  231.    unsigned long int sqrt_4(x)
  232.   unsigned long int x;
  233.      {
  234.      register unsigned long int xroot, m2, x2;
  235.  
  236.   xroot = 0;  m2 = 1 << MAX_BIT * 2;
  237.      do
  238.        {
  239.        x2 = xroot + m2;
  240.        xroot >>= 1;
  241.        if (x2 <= X)
  242.          {
  243.          x -= x2;  xroot += m2;
  244.          }
  245.        }
  246.      while (m2 >>= 2);
  247.     return xroot;
  248.      }
  249.  
  250.  
  251.    unsigned long int sqrt_5(x)
  252.      unsigned long int x;
  253.     {
  254.      register unsigned long int xroot, m2, x2;
  255.  
  256.      xroot = 0;  m2 = 1 << MAX_BIT * 2;
  257.      do
  258.        {
  259.        x2 = xroot + m2;
  260.        xroot >>= 1;
  261.        if (x2 <= X)
  262.          {
  263.          x -= x2;  xroot += m2;
  264.          }
  265.        }
  266.   while (m2 >>= 2);
  267.      if (xroot < x) return xroot + 1;
  268.      return xroot;
  269.   }
  270.  
  271.  
  272.